MacWorld 1999 March - Disc 1/Macworld (1999-03) (Disk 1).dmg/Shareware World/Utilities/Text Processing/Alpha/Tcl/SystemCode/indentation.tcl

Text File | 1998-11-21 | 16.1 KB | 550 lines | [TEXT/ALFA]

## -*-Tcl-*-
 # ###################################################################
 #    Vince's    Additions -    an extension package for Alpha
 #
 #    FILE: "indentation.tcl"
 #                      created: 27/7/97 {1:08:08 am}
 #                     last update: 21/11/98 {3:41:21 pm}
 #    Author:    Vince Darley
 #    E-mail:    <[e-mail]>
 #      mail:    Division of    Applied    Sciences, Harvard University
 #            Oxford Street, Cambridge MA    02138, USA
 #       www:    <http://www.fas.harvard.edu/~darley/>
 #
 # ###################################################################
 ##

alpha::feature electricBraces 0.1 {global C C++ Java Tcl Perl} {
    set electricBraces 0
} {set electricBraces 1} {set electricBraces 0} help {
    Enabling the 'Electric Braces' feature tells Alpha to treat the
    left or right brace '{', '}' keys as special keypresses which
    enter the '{' or '}' character, followed by a return and then
    indent the following line correctly.  It is useful for those
    programming modes in which '{' and '}' are used to delineate
    blocks of code in 'for' loops or 'if-then-else' groups etc.
}

alpha::feature electricSemicolon 0.1 {global C C++ Java Perl} {
    set electricSemicolon 0
} {set electricSemicolon 1} {set electricSemicolon 0} help {
    Enabling the 'Electric Semicolon' feature tells Alpha to treat the
    semicolon keys ';' as special keypresses which enters the ';'
    character followed by a return and then indents the following line
    correctly.  It is useful for some programming modes in which ';'
    normally ends a line.

    The ';' key is context-dependent so you can still enter a
    for( ; ; ) loop in C mode (for instace) without Alpha messing
    things up.
}

alpha::feature electricReturn 0.1 {global} {
    if {[info tclversion] >= 8.0} {
    linkVar indentOnReturn
    }
    set indentOnReturn 0
} {set indentOnReturn 1} {set indentOnReturn 0} help {
    Enabling the 'Electric Return' feature tells Alpha to indent the
    following line automatically whenever you press return.
}

alpha::feature electricColon 0.1 {global} {
    set electricColon 0
} {set electricColon 1} {set electricColon 0} help {
    Enabling the 'Electric Colon' feature tells Alpha to carry out a
    special action when the user presses colon.
}

alpha::feature autoContinueComment 0.1 {global} {
    set autoContinueComment 0
} {set autoContinueComment 1} {set autoContinueComment 0} help {
    Enabling the 'autoContinueComment' feature tells Alpha to check when
    the users hits return whether the current line is a comment, and if
    so, to indent and insert comment characters so that the following
    line continues the comment.
}

alpha::feature indentUsingSpacesOnly 0.1 {global TeX} {
    set indentUsingSpacesOnly 0
} {set indentUsingSpacesOnly 1} {set indentUsingSpacesOnly 0} help {
    If set, do not use tabs to indent, but spaces only.  This is mostly
    useful for modes in which the 'tab' character has a special meaning,
    such as python or TeX (the latter usually only for TeX as a programming
    language, not as a document preparation system).
}

alpha::feature commentsArentSpecialWhenIndenting 0.1 {global TeX} {
    set commentsArentSpecialWhenIndenting 0
} {set commentsArentSpecialWhenIndenting 1} {set commentsArentSpecialWhenIndenting 0} help {
    Indent lines to level of previous line if set, otherwise to level
    of previous non-comment line (in which case Alpha will search
    backwards for some distance).  If you're in the habit of indenting
    your comments to the same level as your code, this setting
    shouldn't matter (and setting it is slightly more efficient).

    One case in which it can be _much_ more efficient is when your
    files contain vast comments (especially .dtx files in TeX mode,
    for instance).  For these files, you should activate this feature.
}

namespace eval indent {}
namespace eval Bind {}
namespace eval text {}

proc IndentLine {} { bind::IndentLine }

proc typeText {t} {
    if {[isSelection]} {
    deleteSelection
    }
    insertText $t
}

proc normalLeftBrace {} {
    typeText "\{"
}
proc normalRightBrace {} {
    typeText "\}"
    blink [matchIt "\}" [pos::math [getPos] - 2]]
}

proc literalChar {} {
    return [expr {[lookAt [pos::math [getPos] - 1]] == "\\"}]
}

# ◊◊◊◊ Electric indentation ◊◊◊◊ #
proc bind::LeftBrace {} {
    if {[isSelection]} { deleteSelection }
    global electricBraces mode
    if {!$electricBraces} {
    insertText "\{"
    return
    }
    mode::proc electricLeft
}

proc ::electricLeft {} {
    if {![catch {search -l [lineStart [pos::math [lineStart [getPos]] - 1]] \
      -s -f 0 -r 0 "\}" [getPos]} res]} {
    set end [getPos]
    if {[pos::compare [getPos] != [maxPos]]} {
        set end [pos::math $end + 1]
    }

    if {[regexp "\}\[ \t\r\n\]*else" [getText [lindex $res 0] $end]]} {
        set res2 [search -s -f 0 -r 1 {else} [getPos]]
        oneSpace
        set text [getText [lindex $res2 0] [getPos]]
        if {[lookAt [pos::math [getPos] - 1]] != " "} {
        append text " "
        }
        replaceText [pos::math [lindex $res 0] + 1] [getPos] " $text\{\r"
        bind::IndentLine
        return
    }
    }
    set pos [getPos]
    set i [text::firstNonWsLinePos $pos]

    if {([pos::compare $i == $pos]) || ([lookAt [pos::math $pos - 1]] == " ")} {
    insertText "\{\r" [text::indentString $pos] [text::Tab]
    } else {
    insertText " \{\r" [text::indentString $pos] [text::Tab]
    }
}

proc ::electricRight {} {
    set pos [getPos]
    set start [lineStart $pos]

    if {[catch {matchIt "\}" [pos::math $pos - 1]} matched]} {
    beep
    message "No matching '\{'!"
    return
    }
    set text [getText [lineStart $matched] $matched]
    regexp "^\[ \t\]*" $text indentation
    if {[string trim [getText $start $pos]] != ""} {
    insertText "\r" $indentation "\}\r" $indentation
    blink $matched
    return
    }
    set text "${indentation}\}\r$indentation"
    replaceText $start $pos $text
    goto [pos::math $start + [string length $text]]
    blink [matchIt "\}" [pos::math $start - 2]]
}

proc bind::RightBrace {} {
    if {[isSelection]} { deleteSelection }
    global electricBraces mode
    if {!$electricBraces} {
    insertText "\}"
    catch {blink [matchIt "\}" [pos::math [getPos] - 2]]}
    return
    }
    mode::proc electricRight
}

proc bind::electricSemi {} {
    if {[isSelection]} { deleteSelection }
    global electricSemicolon mode
    if {!$electricSemicolon} {
    insertText ";"
    return
    }
    mode::proc electricSemi
}

proc ::electricSemi {} {
    set pos [getPos]
    set start [lineStart $pos]
    set text [getText $start $pos]

    if {[string first "for" $text] != "-1"} {
    set paren 0
    set len [string length $text]
    for {set i 0} {$i < $len} {incr i} {
        switch -- [string index $text $i] {
        "("    { incr paren }
        ")"    { incr paren -1 }
        }
    }
    if {$paren != 0} {
        insertText ";"
        return
    }
    }

    insertText ";\r" [text::indentString $pos]
}

##
 # -------------------------------------------------------------------------
 #
 # "bind::CarriageReturn" --
 #
 #    General    purpose    CR procedure.  Should be bound to 'return' for all
 #    modes really.  Calls a mode-specific procedure if required.
 # -------------------------------------------------------------------------
 ##
proc bind::CarriageReturn {} {
    if {[isSelection]} { deleteSelection }
    global autoContinueComment
    if {$autoContinueComment && ([text::isInComment [set p [getPos]] start])} {
    # special case for beginning of line
    if {[pos::compare $p == [lineStart $p]]} {
        backwardChar
    }
    insertText "\r${start}"
    return
    }
    mode::proc carriageReturn
}

proc ::carriageReturn {} {
    insertText "\r"
    global indentOnReturn
    if {$indentOnReturn} {bind::IndentLine}
}

proc bind::IndentLine {} {
    mode::proc indentLine
}

proc insertActualTab {} { typeText "\t" }



##
 # -------------------------------------------------------------------------
 #
 # "text::isInComment" --
 #
 #    Are    we in a    block comment?    Just checks    if both    the    given line and the
 #    next line commence with    any    of a set of    known block-comment    characters.
 #    Not 100% satisfactory for C comments, but fine for all others.
 # -------------------------------------------------------------------------
 ##
proc text::isInComment {pos {st ""}} {
    set p [lineStart $pos]
    if {[pos::compare $pos == $p] && [pos::compare $p != [minPos]]} {
    set pos [pos::math $pos - 1] ; set p [lineStart $pos]
    }
    set q [nextLineStart $pos]
    set t [getText $p $q]
    if { $st != "" } {
    upvar $st a
    }
    if {![catch {commentCharacters "Paragraph"} cpar]} {
    if {[regexp "^\[ \t\]*[quote::Regfind [lindex $cpar 0]]" $t a]} {
        if {![regexp "[quote::Regfind [lindex $cpar 1]]" $t]} {
        set len [string length [lindex $cpar 2]]
        set a [string range $a 0 [expr {[string length $a] - $len -1}]]
        append a [lindex $cpar 2]
        return 1
        }
    }
    }
    # if the next line is a comment
    set qq [text::firstNonWsLinePos $q]
    if {[pos::compare $qq == [maxPos]]} {
    return 0
    }
    foreach commentCh [commentCharacters "General"] {
    if {[regexp  "^\[ \t\]*[quote::Regfind ${commentCh}]\[ \t\]*" $t a]} {
        # if we hit return in the middle of a line
        if {[string trim [getText $pos $q]] != "" && [pos::compare $pos != $p]} {
        return 1
        }
        if {[getText $qq [pos::math $qq + [string length $commentCh]]] == $commentCh} {
        return 1
        }
    }
    }
    return 0
}


# ◊◊◊◊ Indentation utility routines ◊◊◊◊ #

proc posX {pos} {return [lindex [posToRowCol $pos] 1] }
# the above version doesn't work!
if {[info tclversion] < 8.0} {
proc posX {pos} {return [string length [text::maxSpaceForm [getText [lineStart $pos] $pos]]]}
}

proc text::firstNonWs {pos} {
    set p [text::firstNonWsPos $pos]
    if {[pos::compare $p > [minPos]]} {
    return [lookAt $p]
    } else {
    return ""
    }
}

##
 # -------------------------------------------------------------------------
 #
 # "text::firstNonWsPos" --
 #
 #  This returns the position of the first non-whitespace character from
 #  the start of pos' line.  It need not return something on the same
 #  line.
 # -------------------------------------------------------------------------
 ##
proc text::firstNonWsPos {pos} {
    if {[catch {lindex [search -s -f 1 -r 1 "\[^ \t\r\n\]" [lineStart $pos]] 0} res]} {
    return [lineStart $pos]
    } else {
    return $res
    }
}

proc text::firstNonWsLinePos {pos} {
    if {[catch {lindex [search -s -f 1 -r 1 "\[^ \t\]" [lineStart $pos]] 0} res]} {
    return [lineStart $pos]
    } else {
    return $res
    }
}

proc text::indentation {pos} {
    return [search -s -m 0 -f 1 -r 1 "^\[ \t\]*\[^ \t\]" [lineStart $pos]]
}

##
 # -------------------------------------------------------------------------
 #
 # "text::minSpaceForm" --
 #
 #  Converts to minimal form: tabs then spaces.  Uses one regsub to do
 #  the job.  Note that the regexp used relies upon the left-to-right
 #  priority of branch matching.  If the regexp library used is more
 #  sophisticated and finds maximal matches, then this is no good.
 #  In that case use:
 #        regsub -all $sp $ws "\t" ws
 #        regsub -all " +\t" $ws "\t" ws
 # -------------------------------------------------------------------------
 ##
proc text::minSpaceForm {ws} {
    regsub -all "([spacesEqualTab]| +\t)" $ws "\t" ws
    return $ws
}

##
 # -------------------------------------------------------------------------
 #
 # "text::maxSpaceForm" --
 #
 #  Converts it to maximal form - just spaces.
 #  Just uses one funky regsub to do the job!  Takes account of tab-size,
 #  spaces interspersed with tabs,...
 # -------------------------------------------------------------------------
 ##
proc text::maxSpaceForm {ws} {
    set sp [spacesEqualTab]
    regsub -all "(($sp)*) *\t" $ws "\\1$sp" ws
    return $ws
}

##
 # -------------------------------------------------------------------------
 #
 # "spacesEqualTab" --
 #
 #  Return the number of spaces equivalent to a single tab.
 # -------------------------------------------------------------------------
 ##
proc spacesEqualTab {} {
    getWinInfo a
    string range "              " 1 $a(tabsize)
}

proc doubleLookAt {pos} {return [getText $pos [pos::math $pos + 2]]}

set bind::_IndentSpaces "                                                   \
                                         "
set bind::_IndentTabs "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t"

proc text::indentOf {size} {
    global bind::_IndentSpaces bind::_IndentTabs indentUsingSpacesOnly
    if {$indentUsingSpacesOnly} {
    return [string range ${bind::_IndentSpaces} 1 $size]
    } else {
    getWinInfo a
    set ret [string range ${bind::_IndentTabs} 1 [expr $size / $a(tabsize)]]
    append ret [string range ${bind::_IndentSpaces} 1 [expr $size % $a(tabsize)]]
    }
    return $ret
}

# returns the indent string of the line named by 'pos'
proc text::indentString {pos} {
    set beg [lineStart $pos]
    regexp "^\[ \t\]*" [getText $beg [nextLineStart $beg]] white
    return $white
}

# returns the indent string of the line up to position 'pos'
proc text::indentTo {pos} {
    regexp "^\[ \t\]*" [getText [lineStart $pos] $pos] white
    return $white
}

proc text::halfTab {} {
    global indent_amounts
    return [string range "              " 1 $indent_amounts(1)]
}
proc text::Tab {} {
    global indentationAmount
    return [text::indentOf $indentationAmount]
}

proc text::getTabSize {} {
    getWinInfo a
    return $a(tabsize)
}

# ◊◊◊◊ General purpose indentation ◊◊◊◊ #

proc indentSelection {} {
    mode::proc indentRegion
}

##
 # -------------------------------------------------------------------------
 #
 # "text::inCommentBlock" --
 #
 #  Returns 'startpos endpos' if true, else returns an error.  Not
 #  particularly robust, but not too bad either
 # -------------------------------------------------------------------------
 ##
proc text::inCommentBlock {pos} {
    set chars [commentCharacters Paragraph]
    set start [string trim [lindex $chars 0]]
    set end [string trim [lindex $chars 1]]
    if {$start == $end} {
    error "No"
    }
    set cS [search -s -f 0 -r 0 -l [pos::math $pos - 1000] $start $pos]
    set cE [search -s -f 1 -r 0 -l [pos::math $pos + 1000] $end [lindex $cS 1]]
    if {[pos::compare $pos >= [lindex $cE 1]]} {
    error "No"
    } else {
    return [list [lindex $cS 0] [lindex $cE 1]]
    }
}


# Tom's new regexp which I don't use now.  Shame.
#set commentRegexp       {/\*[^*]*\*+([^/*][^*]*\*+)*/}

#########################################################################
# Generic C-style indentation (works for Tcl and Perl)
# Significant changes by Vince.
proc ::indentLine {} {
    global commentsArentSpecialWhenIndenting
    # get details of current line
    set beg [lineStart [getPos]]
    set text [getText $beg [nextLineStart $beg]]
    regexp "^\[ \t\]*" $text white
    set len [string length $white]
    set epos [pos::math $beg + $len]

    if {[pos::compare $beg != [minPos]]} {
    # Find last previous non-comment line and get its leading whitespace
    set pos $beg
    while 1 {
        if {[pos::compare $pos == [minPos]] || [catch {search -s -f 0 -r 1 -i 0 -m 0 "^\[ \t\]*\[^ \t\r\n\]" [pos::math $pos - 1]} lst]} {
        # search failed at top of file
        set line "#"
        set lwhite 0
        break
        }
        if {!$commentsArentSpecialWhenIndenting && \
          ![catch {text::inCommentBlock [lindex $lst 0]} res]} {
        set pos [lindex $res 0]
        } else {
        set line [getText [lindex $lst 0] [pos::math [nextLineStart [lindex $lst 0]] - 1]]
        set lwhite [posX [pos::math [lindex $lst 1] - 1]]
        break
        }
    }

    regexp "(\[^ \t\])\[ \t\]*\$" $line "" nextC
    global indentationAmount electricColon
    if {($nextC == "\{")} {
        incr lwhite $indentationAmount
    } elseif {$nextC == ":" && $electricColon} {
        incr lwhite [expr {$indentationAmount /2}]
    }

    if {[regexp ":\[ \t\r\n\]*\$" $text] && $electricColon} {incr lwhite [expr {-$indentationAmount / 2}]}
    if {[lookAt $epos] == "\}"} {
        incr lwhite [expr {-$indentationAmount}]
    }
    } else {
    set lwhite 0
    }
    set lwhite [text::indentOf $lwhite]
    if {$white != $lwhite} {
    replaceText $beg $epos $lwhite
    }
    goto [pos::math $beg + [string length $lwhite]]
}


proc ::indentRegion {} {
    set from [lindex [posToRowCol [getPos]] 0]
    set to [lindex [posToRowCol [selEnd]] 0]
    select [getPos]
    while {$from <= $to} {
    goto [rowColToPos $from 0]
    bind::IndentLine
    incr from
    }
}